home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1996 / MacHack 1996.toast / Hacks / Hacks ’87 / Source ƒ.sit / Source ƒ / Pascal ƒ / TML Fkey.Pas ƒ / Launch.pas / Launch.pas
Encoding:
Pascal/Delphi Source File  |  1986-10-19  |  2.5 KB  |  101 lines  |  [TEXT/EDIT]
  1. {-----------------------------------------------------------------
  2.  
  3.     This is the TML Pascal source for an FKEY that launches
  4.     another application from within an application.
  5.  
  6.     LaunchKey version 1.20
  7.     copyright Oct/86, Greg King [72407,175]
  8.  
  9.  -----------------------------------------------------------------}
  10. program myfkey;
  11.  
  12. {$H 'PAS$FKEYHeader'}       { we want the special FKEY header }
  13. {$C 'FKEY' 5 'LaunchKey'}    { create an FKEY resource with an ID = 5}
  14. {$T 'FKEY' 'QD15'}         { make an FKEY Installer document }
  15. {$O-}
  16. {$R-}
  17. uses macintf;
  18.     PROCEDURE FKEY; { must be called FKEY }
  19.  
  20.     { see Macintosh Tech Note 52 about the following types }
  21.  
  22.        TYPE
  23.            LaunchStruct = RECORD
  24.                    pfName : StringPtr;
  25.                    param : integer;
  26.                END; {LaunchStruct}
  27.            pLaunchStruct = ^LaunchStruct;
  28.         VAR
  29.             mylaunch : LaunchStruct;
  30.             plaunch : pLaunchStruct;
  31.             name : StringPtr;
  32.             r : rect;  { rectangle for my copyright window }
  33.             reply : SFReply;
  34.             mywindow, savewindow : WindowPtr;
  35.             mytype : SFTypeList;
  36.             pt : Point;
  37.             err : OSErr;
  38.             mytext : Str255;
  39.  
  40.     { see Macintosh Tech Note 52 about the following procedure }
  41.  
  42.         PROCEDURE Launch (p : pLaunchStruct);
  43.         INLINE
  44.             $205F, $A9F2;
  45.  
  46.     BEGIN
  47.  
  48.        { save the current window context and put up my copyright window }
  49.  
  50.         GetPort(savewindow);
  51.         SetRect(r, 150, 40, 350, 80);
  52.         mytext := 'x';
  53.         mywindow := NewWindow(NIL, r, mytext, TRUE, 1, WindowPtr(-1), False, LongInt(0));
  54.         SetPort(mywindow);
  55.         HideCursor;
  56.         TextSize(9);
  57.         MoveTo(10, 10);
  58.         mytext := 'LaunchKey 1.20';
  59.         DrawText(Pointer(Ord(@mytext) + 1), 0, 14);
  60.         MoveTo(10, 20);
  61.         mytext := '©Greg King - Oct 10/86';
  62.         DrawText(Pointer(Ord(@mytext) + 1), 0, 22);
  63.         MoveTo(10, 30);
  64.         mytext := 'Open an application to launch';
  65.         DrawText(Pointer(Ord(@mytext) + 1), 0, 29);
  66.         ShowCursor;
  67.  
  68.         { call SFGetFile and look for applications }
  69.  
  70.         mytype[0] := 'APPL';
  71.         SetPt(pt, 75, 100);
  72.         SFGetFile(pt, '', ProcPtr(NIL), 1, mytype, ProcPtr(NIL), reply);
  73.  
  74.         { restore original window context }
  75.  
  76.         DisposeWindow(mywindow);
  77.         SetPort(savewindow);
  78.         IF reply.good = TRUE THEN { if cancel wasn't pressed }
  79.             BEGIN
  80.  
  81.                { set new volume }
  82.  
  83.                 name := @reply.fName;
  84.                 err := SetVol(name, reply.vRefNum);
  85.                 IF err = noErr THEN { if no errors then launch }
  86.                     BEGIN
  87.  
  88.                        { see Tech note 52 }
  89.  
  90.                         pLaunch := @mylaunch;
  91.                         mylaunch.pfName := name;
  92.                         mylaunch.param := 0;
  93.                         Launch(plaunch);
  94.                     END
  95.                 ELSE
  96.                     SysBeep(3); { if problems, beep and return to the user }
  97.             END;
  98.     END; {FKEY}
  99.  
  100. begin {we cant have anything here!}
  101. end.